home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Snippets / NewFader 2.0 / GammaPaslib.p next >
Encoding:
Text File  |  1996-05-08  |  10.9 KB  |  363 lines  |  [TEXT/PJMM]
  1. unit GammaPaslib;
  2.  
  3. {--------------------------------------------------------------------------------------------------------------- }
  4. { File "gamma.p" - Source for Altering the Gamma Tables of GDevices from Gamma.c                                 }
  5. {   Last updated 6/29/95, MJS                                                                                     }
  6. {--------------------------------------------------------------------------------------------------------------- }
  7. {    7-13-95    ported to pascal  by Matthew Xavier Mora mxmora@mxmdesigns.com                                         }
  8. {     7-18-95     fixed all the porting bugs and got it to work in think pascal                                     }
  9. {----------------------------------------------------------------------------------------------------------------}
  10. {     7-18-95 ported to CW (68k and PPC) by Bill Catambay (pretty easy), cleaned the code a bit (no more labels),     }
  11. {           brought back Matthew's delay fade routines (in main program).                                             }
  12. {----------------------------------------------------------------------------------------------------------------}
  13.  
  14.  
  15.  
  16. {---------------------------------------------------------------------------------------------------------------}
  17. {    This is the Source Code for the Gamma Utils Library file. Use this to build                                    }
  18. {        new functionality into the library or make an A4-based library.                                         }
  19. {    See the header file "gamma.h" for much more information. -- MJS                                                }
  20. {---------------------------------------------------------------------------------------------------------------}
  21. interface
  22.  
  23.     uses
  24. {$IFC UNDEFINED THINK_PASCAL}
  25.         ToolUtils, Files, Devices, 
  26. {$ENDC}
  27.         Traps, Video;
  28.  
  29.     const
  30.         kGammaUtilsSig = 'GAMA';
  31.         kGetDeviceListTrapNum = $AA29;
  32.  
  33.     type
  34.         globalGammasPtr = ^globalGammas;
  35.         globalGammasHdl = ^globalGammasPtr;
  36.         globalGammas = record
  37.                 size, dataOffset: Integer;
  38.                 saved, hacked: GammaTblHandle;
  39.                 theGDevice: GDHandle;
  40.                 next: globalGammasHdl;
  41.             end;
  42.         gammaData = packed array[0..100000] of Byte;  {used to set the gamma}
  43.         gammaDataPtr = ^gammaData;
  44.  
  45.     var
  46.         gammaUtilsInstalled: OSType;
  47.         gammaTables: globalGammasHdl;
  48.  
  49.  
  50. { Function Prototypes}
  51.  
  52.     function IsGammaAvailable: Boolean;
  53.  
  54.     function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;
  55.  
  56.  
  57. {    These routines help you determine whether you can use the Gamma Table Utils}
  58. {        on the current machine. The first checks all attached monitors, and the }
  59. {        second just checks the indicated monitor. Each returns TRUE if you can }
  60. {        use the functions, or FALSE if you can't. • Note: Before calling any other}
  61. {        Gamma Table function below, use this function to see if you are allowed.}
  62.  
  63. { * ****************************************************************************** *}
  64.  
  65.     function SetupGammaTools: OSErr;
  66.  
  67.     function DisposeGammaTools: OSErr;
  68.  
  69.  
  70. {    These routines must bracket any calls to the Gamma Table functions, perhaps}
  71. {        at the head and tail of your main(). The first sets up the data structures}
  72. {        necessary to save and restore the state of your monitors. The second}
  73. {        disposes of all the internal data structures, but does not reset the}
  74. {        monitors to their original states. Both return the error code if some}
  75. {        part failed. }
  76.  
  77. { * ****************************************************************************** *}
  78.  
  79.     function DoGammaFade (percent: Integer): OSErr;
  80.     function DoOneGammaFade (theGDevice: GDHandle; percent: Integer): OSErr;
  81.  
  82.  
  83. {    Use the first function to Fade each of your monitors to some percentage of their}
  84. {        initial brightness (100 = bright, 0 = dim). Repeatedly call this to ramp your}
  85. {        monitors up or down. The second function performs the same function, but only}
  86. {        for the specified monitor. Both return any applicable error codes.}
  87. {    Be sure to set up the necessary save-state data structures before you start by}
  88. {        calling the compatibility and initialization functions. }
  89.  
  90. { * ****************************************************************************** *}
  91.  
  92.     function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  93.     function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  94.  
  95.  
  96. {    These routines are low-level interfaces to the device drivers for the monitors.}
  97. {        Use them at your own risk.}
  98.  
  99.  
  100. implementation
  101.  
  102.     function IsGammaAvailable: Boolean;
  103.  
  104.         var
  105.             theGDevice: GDHandle;
  106.  
  107.     begin
  108.         IsGammaAvailable := false;
  109.         if (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = NGetTrapAddress(_Unimplemented, ToolTrap)) then
  110.             exit(IsGammaAvailable);
  111.         theGDevice := GetDeviceList;
  112.         while (theGDevice <> nil) do
  113.             begin
  114.                 if (TestDeviceAttribute(theGDevice, screenDevice) and TestDeviceAttribute(theGDevice, noDriver)) then
  115.                     exit(IsGammaAvailable);
  116.                 if (theGDevice^^.gdType = fixedType) then
  117.                     exit(IsGammaAvailable);
  118.                 theGDevice := GetNextDevice(theGDevice);
  119.             end;
  120.         IsGammaAvailable := true; {If we made it this far then its true}
  121.     end;
  122.  
  123.  
  124.     function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;
  125.  
  126.     begin
  127.         IsOneGammaAvailable := false;
  128.         if (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = NGetTrapAddress(_Unimplemented, ToolTrap)) then
  129.             exit(IsOneGammaAvailable);
  130.         if (TestDeviceAttribute(theGDevice, screenDevice) and TestDeviceAttribute(theGDevice, noDriver)) then
  131.             exit(IsOneGammaAvailable);
  132.         if (theGDevice^^.gdType = fixedType) then
  133.             exit(IsOneGammaAvailable);
  134.         IsOneGammaAvailable := true;
  135.     end;
  136.  
  137.  
  138.     function SetupGammaTools: OSErr;
  139.  
  140.         var
  141.             errorCold: Integer;
  142.             tempHdl: globalGammasHdl;
  143.             masterGTable: GammaTblPtr;
  144.             theGDevice: GDHandle;
  145.  
  146.     begin
  147.         if (gammaUtilsInstalled = kGammaUtilsSig) then
  148.             begin
  149.                 SetupGammaTools := -1;
  150.                 exit(SetupGammaTools);
  151.             end;
  152.         gammaTables := nil;
  153.         gammaUtilsInstalled := kGammaUtilsSig;
  154.         theGDevice := GetDeviceList;
  155.         while (theGDevice <> nil) do
  156.             begin
  157.                 errorCold := GetDevGammaTable(theGDevice, masterGTable);
  158.                 if (errorCold <> 0) then
  159.                     begin
  160.                         SetupGammaTools := errorCold;
  161.                         exit(SetupGammaTools);
  162.                     end;
  163.                 tempHdl := globalGammasHdl(NewHandle(sizeof(globalGammas)));
  164.                 if (tempHdl = nil) then
  165.                     begin
  166.                         SetupGammaTools := MemError;
  167.                         exit(SetupGammaTools);
  168.                     end;
  169.                 with masterGTable^ do
  170.                     begin
  171.                         tempHdl^^.size := sizeof(GammaTbl) + gFormulaSize + (gChanCnt * gDataCnt * gDataWidth div 8);
  172.                         tempHdl^^.dataOffset := gFormulaSize;
  173.                         tempHdl^^.theGDevice := theGDevice;
  174.                     end;
  175.                 tempHdl^^.saved := GammaTblHandle(NewHandle(tempHdl^^.size));
  176.                 if (tempHdl^^.saved = nil) then
  177.                     begin
  178.                         SetupGammaTools := MemError;
  179.                         exit(SetupGammaTools);
  180.                     end;
  181.                 tempHdl^^.hacked := GammaTblHandle(NewHandle(tempHdl^^.size));
  182.                 if (tempHdl^^.hacked = nil) then
  183.                     begin
  184.                         SetupGammaTools := MemError;
  185.                         exit(SetupGammaTools);
  186.                     end;
  187.                 BlockMove(Ptr(masterGTable), Ptr(tempHdl^^.saved^), tempHdl^^.size);
  188.                 tempHdl^^.next := gammaTables;
  189.                 gammaTables := tempHdl;
  190.                 theGDevice := GetNextDevice(theGDevice)
  191.             end;
  192.         SetupGammaTools := 0;
  193.     end;
  194.  
  195.     function DoGammaFade (percent: Integer): OSErr;
  196.  
  197.         var
  198.             errorCold: Integer;
  199.             thesize, i, theNum: LongInt;
  200.             tempHdl: globalGammasHdl;
  201.             dataPtr: Ptr;
  202.             tempGammaTbl: GammaTblPtr;
  203.             gdp: gammaDataPtr;
  204.             tempLong: Longint;
  205.  
  206.     begin
  207.         if (gammaUtilsInstalled <> kGammaUtilsSig) then
  208.             begin
  209.                 DoGammaFade := -1;
  210.                 exit(DoGammaFade);
  211.             end;
  212.         tempHdl := gammaTables;
  213.         while (tempHdl <> nil) do
  214.             begin
  215.                 with tempHdl^^ do
  216.                     begin
  217.                         BlockMove(Ptr(saved^), Ptr(hacked^), size);
  218.                         tempLong := ord(@hacked^^.gFormulaData) + dataOffset;
  219.                         gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
  220.                         thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
  221.                     end;
  222.                 for i := 0 to thesize - 1 do
  223.                     begin
  224.                         theNum := gdp^[i];
  225.                         theNum := (theNum * percent) div 100;
  226.                         gdp^[i] := theNum;
  227.                     end;
  228.                 errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
  229.                 if (errorCold <> 0) then
  230.                     begin
  231.                         DoGammaFade := errorCold;
  232.                         exit(DoGammaFade);
  233.                     end;
  234.                 tempHdl := tempHdl^^.next;
  235.             end;
  236.         DoGammaFade := 0;
  237.     end;
  238.  
  239.     function DoOneGammaFade (theGDevice: GDHandle; percent: Integer): OSErr;
  240.  
  241.         var
  242.             errorCold: Integer;
  243.             thesize, i, theNum: LongInt;
  244.             tempHdl: globalGammasHdl;
  245.             gdp: gammaDataPtr;
  246.  
  247.     begin
  248.         if (gammaUtilsInstalled <> kGammaUtilsSig) then
  249.             DoOneGammaFade := -1;
  250.         tempHdl := gammaTables;
  251.         while ((tempHdl <> nil) and (theGDevice <> tempHdl^^.theGDevice)) do
  252.             tempHdl := tempHdl^^.next;
  253.         with tempHdl^^ do
  254.             begin
  255.                 BlockMove(Ptr(saved^), Ptr(hacked^), size);
  256.                 gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
  257.                 thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
  258.             end;
  259.         for i := 0 to thesize - 1 do
  260.             begin
  261.                 theNum := gdp^[i];
  262.                 theNum := (theNum * percent) div 100;
  263.                 gdp^[i] := theNum;
  264.             end;
  265.         errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
  266.         DoOneGammaFade := errorCold;
  267.     end;
  268.  
  269.     function DisposeGammaTools: OSErr;
  270.  
  271.         var
  272.             tempHdl, nextHdl: globalGammasHdl;
  273.  
  274.     begin
  275.         if (gammaUtilsInstalled <> kGammaUtilsSig) then
  276.             begin
  277.                 DisposeGammaTools := -1;
  278.                 exit(DisposeGammaTools);
  279.             end;
  280.         tempHdl := gammaTables;
  281.         while (tempHdl <> nil) do
  282.             begin
  283.                 HLock(Handle(tempHdl));
  284.                 with tempHdl^^ do
  285.                     begin
  286.                         nextHdl := next;
  287.                         DisposeHandle(Handle(saved));
  288.                         DisposeHandle(Handle(hacked));
  289.                         HUnLock(Handle(tempHdl));
  290.                         DisposeHandle(Handle(tempHdl));
  291.                         tempHdl := nextHdl;
  292.                     end;
  293.             end;
  294.         gammaUtilsInstalled := '    ';
  295.         DisposeGammaTools := 0;
  296.     end;
  297.  
  298.     function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  299.  
  300.         var
  301.             errorCold: Integer;
  302.             myCPB: ParmBlkPtr;
  303.  
  304.     begin
  305.         theTable := nil;
  306.         if not IsOneGammaAvailable(theGDevice) then
  307.             begin
  308.                 GetDevGammaTable := -1;
  309.                 exit(GetDevGammaTable);
  310.             end;
  311.         myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
  312.         if (myCPB = nil) then
  313.             begin
  314.                 GetDevGammaTable := MemError;
  315.                 exit(GetDevGammaTable);
  316.             end;
  317.         myCPB^.csCode := cscGetGamma;
  318.         myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
  319.         myCPB^.csParam[0] := HiWord(longint(@theTable));
  320.         myCPB^.csParam[1] := LoWord(longint(@theTable));
  321.         errorCold := PBStatusSync(myCPB);
  322.         DisposePtr(Ptr(myCPB));
  323.         GetDevGammaTable := errorCold;
  324.     end;
  325.  
  326.     function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
  327.  
  328.         var
  329.             myCPB: ParmBlkPtr;
  330.             errorCold: Integer;
  331.             cTab: CTabHandle;
  332.             saveGDevice: GDHandle;
  333.  
  334.     begin
  335.         if not IsOneGammaAvailable(theGDevice) then
  336.             begin
  337.                 SetDevGammaTable := -1;
  338.                 exit(SetDevGammaTable);
  339.             end;
  340.         myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
  341.         if (myCPB = nil) then
  342.             begin
  343.                 SetDevGammaTable := MemError;
  344.                 exit(SetDevGammaTable);
  345.             end;
  346.         myCPB^.csCode := cscSetGamma;
  347.         myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
  348.         myCPB^.csParam[0] := HiWord(longint(@theTable));
  349.         myCPB^.csParam[1] := LoWord(longint(@theTable));
  350.         errorCold := PBControlSync(myCPB);
  351.         if (errorCold = 0) then
  352.             begin
  353.                 saveGDevice := GetGDevice;
  354.                 SetGDevice(theGDevice);
  355.                 cTab := theGDevice^^.gdPMap^^.pmTable;
  356.                 SetEntries(0, cTab^^.ctSize, cTab^^.ctTable);
  357.                 SetGDevice(saveGDevice);
  358.             end;
  359.         DisposePtr(Ptr(myCPB));
  360.         SetDevGammaTable := errorCold;
  361.     end;
  362.  
  363. end.